perm filename NOTWRT.F4[XX,LCS]6 blob sn#198649 filedate 1976-01-28 generic text, type T, neo UTF8
00100		SUBROUTINE NOTWRT
00200		IMPLICIT INTEGER(A-Q,S-Z)
00300		COMMON/DL/IXRX,M,AA /FONT/JFONT 
00400		COMMON/SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
00600		COMMON/DAT/RACNT(65),RDOT(17),XAC(7),RNOTE(22),RACCI(22),NACCI(3)
00700		REAL DIS,CENTR,POS,STFF
00800		COMMON /STF/RSTFAC(-3/4),RSTJ2
00900		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
01000		COMMON/PLTR/PLT,RHT,DIS /POSI/STFF(-3/4),JJ2,POS
01100	C   FOR NOTE DRAWING
01200		COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
01300		1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,J5X,RXX,JJJ,
01400		1 PUNCT,RDIS,RJ
01500		EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R4,RJQ(2))
01600		1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
01700		1,(J11,JQ(9)),(J6,JQ(4)),(R5,RJQ(3)),(R11,RJQ(9))
01800		1,(R8,RJQ(6)),(R7,RJQ(5)),(RX,JRX),(RJZ,RJQ(20)),(R3,RJQ(1))
01900		DATA RACNT/4.0,1000.005,17.0,0.105, 8.0,1003.0, 7.014, 11.0
02000		1,13. ,1000. ,0.010,14.01,14. ,17. ,1001.018,7. ,13.018,27.,
02100		1 1004., 4.002, 6.004, 8.004,10.002,10., 8.102,6.102,4.
02200		1,32.0,1000.0,14.0,1007.007,7.107, 43.0,1012.01,11.006,9.003
02300		1, 7.001, 5.0, 9.002, 13.006, 15.01, 10.004, 13.009, 52.0,
02400		1 1002.008,3.003, 5.001, 8.0, 10.0, 13.001, 15.003, 16.008,
02500		1 65.,1106.104, 0.002, 6.104, 12.002, 18.104, 24.002, 24.003,
02600		1 18.103, 12.003, 6.103, 0.003, 106.103/
02700	     1 ,RNOTE/ 1000., 5.007, 11.007, 16., 11.107, 5.107, 0.0,
02800	     1 1000.0, 7.007, 14.0, 7.107, 0,  1000.107, 14.007,
02900	     1 1014.107,0.007, 1000.003,4.107,6.007,9.107,11.007,14.103/
03000		DATA RDOT/1000.101, .102, 1.103, 2.103, 3.102, 3.101, 2., 1.,
03050		1 .101, 2.103, 2., .102, 3.102, 1., 1.103, 3.101, .102/
03100		1 , R5/5.0/, R66/66.0/, R72/72.0/,R18/18.0/,RSTM/14.54/
03200		1 ,XAC/9,14,18,28,33,44,53/
03300	C   ALL DATA NUMS OVER 90 GIVE INVISIBLE VECTORS
03400		DATA RACCI/6.0,1115.003, 110.007, 106.001,
03500	     1 115.109, 115.021, 15.0, 1104.104, 118.108,
03600	     1 1108.113, 108.016,  1104.008, 118.004,
03700	     1 1114.014, 114.115, 22.0,1106.117, 106.007, 114.004
03800	     1, 1114.018, 114.107, 106.104/
03900	     1 ,NACCI/1,7,16/
04000	
04100		RST7=7.*RSTJ2
04200		RST3=3.*RSTJ2
04300		RSTX=RSTJ2
04400	C  FOR MINIS AT 245
04500		RMINI=RSTJ2
04600	C  OR SHOULD THIS ONLY BE IN NOTES, ETC?  15/9/72
04700	
04800		RINV=1
04900		IF(JA.EQ.1)GO TO 11
05000		IF(JA.EQ.9)GO TO 242
05100	
05200	C  NEXT IS FOR RESTS
05300		IF(R8.NE.0)J5=-2
05400	C  R8 PUTS NUMBER OVER WHOLE REST ONLY.
05500		IF(J5.GT.1)R4=R4-2
05600	CC	RA=R4
05700		R7=R6*10.
05800	C  FOR DOTS
05900	202	CALL REST
06000		IF(J5.GT.1)GO TO 200
06100		IF(R7.EQ.0)RETURN
06200	201	RA=14
06300		R6=0
06400		IF(J5)RA=19
06500		R3=R3+RA*RSTJ2
06600		R4=8.+R4
06700		JA=9
06800		J5=7
06900	C   IF P6=1 THE REST IS DOTTED
07000		CALL CENTX
07100		GO TO 242
07200	200	J5=J5-1
07300	C  FOR MULTIPLE TAILS ON 16TH REST, ETC.
07400		R4=R4+2.
07500		CALL RJBX(4.3)
07600		GO TO 202
07700	
07800	29	RJX=R3
07900		RJY=CENTR+RSTJ2
08000	108	IF(WHOLE.NE.0)RJX=RJX+3.*RMINI
08100	C WHOLE=1 MEANS IT'S A WHOLE NOTE (WIDER THAN A HALF.)
08200		WHOLE=0
08210		RG=9
08220		IF(PLT)RG=17
08230	C  DOESN'T FILL DOT ON DPY
08300	107	CALL RDRAW(1,RG,RDOT,RMINI,RJX,RJY,RMINI)
08400	C    ****   ****    ***  ↑↑↑↑↑↑↑↑↑↑ THESE WERE RSTJ2 11/74
08500		IF(JA.EQ.1)GO TO 290
08600		IF(R7.GE.20.)GO TO 290
08700		RB=POS+52.*RSTJ2
08800		IF(RJY.NE.RB)GO TO 6241
08900	C   WHERE IS RB USED LATER?
09000		RJY=RJY-12*RSTJ2
09100		GO TO 107
09200	C  ABOVE FOR DOTS
09300	290	R7=R7-10.
09400		IF(R7.LT.10.)GO TO 1342
09500		RJX=RJX+RSTJ2*10.
09600		GO TO 107
09700	
09800		GO TO 1121
09900	
10000	C  NOTES****
10100	11	JY=0
10200		IF(R6.EQ.0)GO TO 1015
10300		JY=IABS(J6)
10400		R6=ABS(AMOD(R6,1.0))*10.
10500	C   R6 WILL HAVE ACCENT CODE # (.7=DOT, ETC.)
10600	1015	L=IABS(J4)
10700		RJAC=R3
10800	C   TO SAVE POS. OF NOTE FOR ACCENT
10900		RZTM=2.*RSTJ2
11000		STEM=J5/10
11100	1010	IF(L.LT.100)GO TO 1013
11200		IF(L.LT.200)GO TO 1012
11300		RZTM=0
11400		IF(L.GE.300)GO TO 1014
11500		KL=8
11600		RG=12.0
11700	C  FOR DIAMOND NOTES.
11800		GO TO 1013
11900	1014	IF(L.GE.400)GO TO 1016
12000		RJX=RMINI*7
12100	C  FOR "X" NOTES.
12200		KL=13
12300		RG=16.
12400		RB=CENTR+RJX
12500		IF(STEM.EQ.2)RB=CENTR-RJX
12510		GO TO 1013
12610	1016	IF(L.LT.1000.OR.L.GE.10000)GO TO 1011
12620		KL=-1
12630		IF(L.LT.2000)KL=-KL
12640	C PUTS NOTE ON STAFF ABOVE(2000) OR BELOW(1000)-NEXT FIND POS ON OTHER STAFF
12650		RB=(STFF(J2-KL)-STFF(J2))/RST7
12660		R4=R4+RB
12662		CALL CENTX
12664	C STEM WILL GO TO EQUIV. SPOT ON "HOME" STAFF. USE NEG P8 TO ADJUST
12666		IF(R8.EQ.999)R8=0
12667		RZ=ABS(RB)
12669	C (((OR MOVE STUFF FROM 128 UP TO 11)))
12670		IF(KL.AND.J5.GE.20)RZ=-RZ
12672		IF(KL.GT.0.AND.J5.LT.20)RZ=-RZ
12674		R8=R8-RZ
12680		CALL CENTX
12682	C  RESET BASIC VERT. POS. (BASED ON P4. AMOD IS DONE IN CENTX)
12684		L=MOD(L,1000)
12686		J9=-1
12690	C  SUPRESSES LEDGER LINES
12695		GO TO 1010
12700	1011	IF(L.LT.10000)GO TO 1019
12750		GO TO 1013
12760	
12800	1019	IF(L.GE.500)GO TO 1017
12850		RB=CENTR+R11*RST7
12900	C  +400 FOR NO NOTE HEAD.  P11 CAN ADJUST SOURCE OF STEM.
13000		GO TO 1013
13010	1017	RG=R4
13032		CALL EARLY
13033	C  THE EARLY MUSIC PACKAGE.  +500
13080		RETURN
13100	
13200	1012	RMINI=.6*RSTJ2
13300	C  FOR RMINI NOTES
13400	CC** DONE IN CENTX *** 1017	R4=AMOD(R4,100.)
13500	C  FOR MINI TAILS AND ACCIS. ETC.
13600	1013	J4=R4
13700		RJZ=R4
13800	C  RJZ FOR FLAT, #, NAT.   RX4 FOR TR., HARM, ETC.
13900		RX4=R4
14000		IF(JY.LT.10)GO TO 2221
14100		IF(JY.GE.30)GO TO 2221
14200	C P6 FOR HOMING TO RIGHT(10,30) OR LEFT(20) OF STEM(10,30=UP, 20=DOWN)
14300	C P6<0 = WHITE NOTE
14400		RQ=RSTM
14500		IF(J6)RQ=RQ+1.66
14600	C GETS WIDTH OF NOTE DISPLACEMENT
14700		IF(JY.EQ.20)RQ=-RQ
14800		R3=R3+RQ*RMINI
14900	2221	IF(J4.LE.1)GO TO 322
15000		IF(J4.LT.13)GO TO 1121
15100	
15200	322	IF(J9)GO TO 1121
15300	C   ARE THERE LEDGER LINES?  P9=-1 SUPPRESSES THEM.
15400		J11=(J4+1)/2-6
15500		IF(J11)J11=-((3-J4)/2)
15600	
15700	C  FOR LEDGER LINES
15800		RJW=R3-7.*RMINI
15900		RZ=R3+20.*RMINI
16000		IF(J11)GO TO 71
16100		JX=J11
16200		JRX=13
16300	C********* 18/9/72
16400		GO TO 711
16500	71	JX=-J11
16600		JRX=J11*2+3
16700	711	RX=POS-18*RSTJ2+RST7*JRX
16800	C********* 18/9/72
16900		IF(J6)RZ=RZ+2*RMINI
17000	C126	IF(PLT.EQ.-3)GO TO 1126
17100	C  FOR 2-PASS PLOTTING
17200	C   ******* ABOVE IS NOT USED, 15/9/72
17300	126	CALL LINX(RJW,RX,RZ,RX)
17400		IF(PLT.NE.-2)GO TO 1126
17500		RJY=RX-1./RHT
17600		CALL LINX(RJW,RJY,RZ,RJY)
17700	1126	IF(JX.EQ.1)GO TO 1122
17800		RX=RX+RSTJ2*14.
17900		JX=JX-1
18000		GO TO 126
18100	1122	J9=-1
18200	
18300	C  IF J6≠0 NOTE IS FILLED IN
18400	1121	IF(L.GE.400)GO TO 123
18500	C  JUMP IF NO NOTE HEAD
18600		IF(J6)GO TO 1322
18700		IF(L.LT.200)GO TO 125
18800	1322	IF(L.GE.200)GO TO 1253
18900	C  FOR DIAMOND AND X NOTES.
19000		KL=1
19100		RG=7.
19200	C  FOR WHITE NOTES ON DPY.
19300		WHOLE=MOD(J7,10)
19400		IF(WHOLE.EQ.0)GO TO 2122
19500		STEM=0
19600	C  FOR VARIOUS AUTOMATIC FEATURES IN 'SCORE' SECTION.
19700		J7=0
19800		R5=AMOD(R5,10.)
19900		J5=R5
19910		IF(PLT)GO TO 2121
19920		IF(WHOLE.NE.2)GO TO 1253
19922		RQ=POS-18.*RSTJ2+RST7*(R4-1.)
19925		CALL LINX(R3,RQ,R3,RQ+RST7+RST7)
19930	C  PUT IN LINE TO SHOW DBL WHOLE ON SCREEN (P7=2)
20000	2122	IF(PLT.GE.0)GO TO 1253
20100	2121	IF(L.GE.200)GO TO 1253
20200		J5=15+WHOLE
20300	C  IF WHOLE=1, THEN WHOLE NOTE SHAPE INSTEAD OF HALF. (P7=1)
20400		RG=RSTJ2
20500	C FIX THIS SOME DAY↓↓  SEE 1342+1!
20600	CCXX	IF(RMINI.NE.RSTJ2)RSTJ2=.7*RSTJ2
20700	C  THESE NOTES ARE IN CLEF1.  1/2=13   WHOLE=14
20800		JX4=J4
20900		RQ=R7
21000	C  SAVE IT FOR DOTS
21100		CALL DRWNT(RMINI)
21200		R7=RQ
21300		J4=JX4
21400	C  GET IT BACK
21500		RSTJ2=RG
21600	C  DRAWS GOOD NOTES ON PLOTTER -- NOT ON DPY.
21700	CC  DONE IN DRWNT	R7=J7
21800	C  TO RESET IT.
21900		GO TO 123
22000	1251	CALL NOIR(RMINI)
22100	C  FOR QUARTER NOTES ON PLOTTER.
22200		GO TO 123
22300	
22400	125	IF(PLT)GO TO 1251
22500		KL=17
22600		RG=22.
22700	C   ABOVE IS NEW NOTES ROUTINE
22800	1253	CALL RDRAW(KL,RG,RNOTE,RMINI,R3,CENTR,RMINI)
22900		IF(PLT.GE.0)GO TO 123
23000		IF(KL.EQ.8)GO TO 2253
23100		IF(KL.NE.13)GO TO 123
23200	C  MAKE DBL THICK X AND DIAMOND NOTES
23300	2253	RH=R3-1.0
23400		CALL RDRAW(KL,RG,RNOTE,RMINI,RH,CENTR,RMINI)
23500	
23600	123	R5=R5-J5
23700	C  R5=STEPS TO LEFT FOR ACCID. (.1=1 STEP)
23800		IF(STEM.EQ.0)GO TO 1242
23900		IF(L.LT.300)RB=CENTR+RZTM
24000	C************↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑ +2
24100	C  ≥300 IS FOR 'X' NOTES.
24200	128	J7=MOD(J7,10)
24300		RG=(J7-1)*14
24400		IF(RG)RG=0
24500	CC	IF(R8.EQ.999)R8=0
24600	C 999 IS STANDARD (0) STEM LENGTH.
24700		IF(R8.NE.999)GO TO 1751
24800		R8=0
24900		RH=0
25000		GO TO 2751
25100	1751	IF(R8.LT.999)GO TO 751
25200		R8=R8-1000.
25300		J10=1
25400	C  1000+ PUTS SLASH ON NOTE STEM
25500	751	RH=R8*RST7
25600	C  STEM EXTENSIONS ARE BY NOTE #S
25700	2751	IF(STEM.NE.2)GO TO 1280
25800		RJX=R3
25900	C  FOR STEM DOWN (=2)
26000		RG=-RG-48.
26100		RH=-RH
26200		L=20
26300		RB=RB-RZTM*2
26400	C  FOR TILT OF ORDINARY NOTES (NOT X OR DIAMOND)
26500	C************↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑ SEE 21800  12/74
26600		GO TO 129
26700	C  NEXT IS FOR STEM UP.
26800	1280	RJX=RSTM
26900		IF(J6.EQ.0)GO TO 2322
27000		IF(J6.NE.30)RJX=16.2
27100	C  FOR HALF NOTES
27200	2322	RJX=RJX*RMINI+R3
27300		RG=RG+48.
27400		L=10
27500	129	RZ=CENTR+RH+RG*RMINI
27600		IF(RMINI.NE.RSTJ2)RJW=RJW*.6
27700		CALL LINX(RJX,RB,RJX,RZ)
27800	C  RB HERE IS CENTR (FOR 'X' NOTES OR NOT)
27900	227	J5=J5-L
28000	C   J5 HAS ACCID. # NOW
28100		IF(J7.LE.0)GO TO 1242
28200	C   JUMP IF NO TAILS
28300		RJW=2.*RMINI/RSTJ2
28400	C  FOR VERT. SPACING OF MULTIPLE TAILS
28500		IF(STEM.NE.2)GO TO 1127
28600		R4=R4-3.7-R8
28700	C R4 IS USED IN SUBR. TAIL   - R8 IS STEM EXTENSION.
28800		RJW=-RJW
28900		RA=1.
29000		GO TO 127
29100	1127	R4=R4-2+R8
29200	C  2 ABOVE AND 3.7 BEFORE ARE BECAUSE ORIG. POS. OF TAIL DRWING IS OFF.
29300		RA=-1.
29400		R8=0
29500	C  ↑↑↑↑↑↑ FOR SHIFT AT 246
29600	127	CALL TAIL(RJX,RA,RMINI)
29700	1028	J7=J7-1
29800		IF(J7.EQ.0)GO TO 327
29900		R4=R4+RJW
30000	C  MOVES CENTR UP OR DOWN FOR NEXT TAIL
30100		GO TO 127
30200	327	IF(R4.GE.RX4)RX4=R4+1
30300	CC327	IF(R4.GE.RJZ)RJZ=R4+1
30400	C  FOR TRILLS, ETC.
30500		IF(J10.EQ.0)GO TO 1242
30600		RJY=RZ-19*RSTJ2
30700		RZ=RZ-RSTJ2*4.
30800		IF(RA.LT.0)GO TO 1327
30900	C  NEXT IS FOR STEM DOWN SLASH
31000		RJY=RZ+23*RSTJ2
31100		RZ=RZ+RST7
31200	1327	RJX=RJX-RST7
31300		CALL LINX(RJX,RJY,RJX+17.*RSTJ2,RZ)
31400	C  FOR SLASH ON GRACE NOTE TAIL
31500	1242	IF(R7.LT.10.)GO TO 1342
31600	C  FOR DOTTED NOTE-- P7>9 
31700		RJX=RJAC+(22.+AMOD(R7,1.0)*59.6)*RMINI
31800	C***↑↑↑↑↑  WAS 24.  11/74
31900		RJY=CENTR+RSTJ2
32000		IF(JY.EQ.10)GO TO 4322
32100	 	IF(JY.NE.30)GO TO 3322
32200	4322	RJX=RJX+RSTM
32300	C  MOVES DOT TO LEFT
32400	3322	IF(MOD(J4,2).EQ.0)GO TO 108
32500		RX=RST7
32600		IF(JY.GE.20)RX=-RX
32700	3342	RJY=RJY+RX
32800		GO TO 108
32900	C  JY=30= STEM UP, INTERVAL OF SECOND.
33000	1342	IF(J5.NE.0)GO TO 5322
33100		IF(R6.EQ.0)RETURN
33200	5322	R3=R3-R5*59.6*RMINI
33300	C  TO SPACE OUT ACCIDS.
33400	CCXX	IF(RMINI.NE.RSTJ2)RSTJ2=.7*RSTJ2
33500	C   ↑↑↑↑		  ↑↑↑↑↑ WAS RMINI
33600	C********* 18/9/72
33700	242	IF(J5.GE.0)GO TO 2421
33800		RINV=-RINV
33900		J5=-J5
34000	C  NOW THAT 0 IS NOT USED FOR DOTS THE ABOVE 3 LINES COULD BE CHNGD
34100	C********** LAST # WAS 281?
34200	C b,#,NAT, ACC ∧, ACC >, FERMATA, DOT, REP MEAS., DASH
34300	CXX 11/74 2421	RH=14
34400	2421	J5X=-1
34500		JAX=JA
34600	C  USED AT 4241  FOR DOUBLE MARKS ON NOTES.
34700		IF(JA.EQ.9)GO TO 2423
34800		IF(J5.GT.3)GO TO 3121
34900	C  DBL FLT(4) AND DBL SHRP(5)  ALWAYS USE 'DRAW' ROUTINE.
35000		GO TO 211
35100	CC2423	RJZ=AMOD(R4,100.)
35150	2423	RJZ=R4
35200	C  FOR 'DRWNT' WHEN PLOTTING.
35300		CALL NOZERO(R6)
35400	C  R6=SIZE FACTOR  (P6)
35500		RMINI=RMINI*R6
35600		R6=0
35700		STEM=0
35800	C   FOR MISC. ITEMS
35900	210	IF(IABS(J4).LT.100)GO TO 1241
36000	CC210	IF(IABS(J4).LT.100)GO TO 3241
36100		J4=MOD(J4,100)
36200		RMINI=.7*RMINI
36300	CC3421	J5X=-1
36400	C FOR 2 MARKS AT ONCE.
36500	1241	IF(J5.GE.11)GO TO 28
36600		GO TO (211,211,211,28,28,222,249,60,27,27),J5
36700		RETURN
36800	C  ERROR TRAP (I.E. J5=0)
36900	C  FOR 1 OR 2 BAR REP SIGNS.
37000	60	CALL BREP(R3,RSTJ2)
37100		RETURN
37200	
37300	241	CALL LINES(R3,CENTR,3)
37400		GO TO 210
37500	
37600	
37700	211	IF(J5.EQ.0)GO TO 2422
37800	C  GETS BACK GOOD VERTICAL POS.
37900		IF(J5.GT.3)GO TO 222
38000	C  FOR 2-PASS PLOTTING (-2=THIN LINES, -3=HEAVY LINES)
38100		IF(PLT)GO TO 3121
38200		IF(JFONT.NE.0)GO TO 3121
38300		X=NACCI(J5)
38400		CALL RDRAW(X+1,RACCI(X),RACCI,RMINI,R3,CENTR,RMINI)
38500	2422	IF(R6.EQ.0)RETURN
38600		J5=(R6+.001)*100.
38700		R4=RX4
38800	CC	R4=RJZ
38900		R3=RJAC
39000	1249	IF(MOD(J5,10).GT.3)GO TO 249
39100		J5=J5/10
39200		IF(J5.GT.30)GO TO 1249
39300	C WHEN P1=1, EXTRACTS ACCENT NUMBERS FROM DECIMALS IN P6.
39400	249	IF(J5.GT.30)GO TO 28
39500		IF(J5.GT.10)GO TO 246
39600		IF(J5.EQ.0)RETURN
39700		IF(JA.NE.1)GO TO 250
39800	CXX 11/74	RH=8
39900		RB=14.
40000		IF(MOD(J4,2).EQ.0)GO TO 244
40100		IF(J5.EQ.7)GO TO 6322
40200		IF(J5.NE.9)GO TO 244
40300	6322	IF(STEM.GT.1)GO TO 7322
40400		IF(J4.LT.5)GO TO 244
40500	7322	IF(J4.LE.9)GO TO 8322
40600		IF(STEM.EQ.2)GO TO 244
40700		IF(STEM.EQ.0)GO TO 244
40800	8322	RB=21
40900	C   PUTS ACCENT DOWN OR UP 1 SPACE. AVOIDS PUTTING DOT OR DASH ON LINE
41000	244	IF(STEM.EQ.1)GO TO 9322
41100		IF(STEM.NE.0)GO TO 245
41200		IF(J4.GE.7)GO TO 245
41300	9322	RB=-RB
41400	CC	IF(J5.NE.6)GO TO 245
41500	CC	IF(J4.LT.9.AND.STEM.EQ.2)GO TO 281
41600	CC	IF(J4.GT.4.AND.STEM.EQ.1)GO TO 252
41700	245	CENTR=CENTR+RB*RSTX
41800	250	IF(J5.GT.10)GO TO 281
41900		IF(J5.LT.6)GO TO 281
42000		JA=9
42100		IF(J5.NE.7)GO TO 253
42200	C   7=DOT
42300		RXX=R3
42400		R3=R3+6.7*RMINI
42500	C  CENTERS THE DOT
42600		GO TO 29
42700	253	IF(J5.EQ.9)GO TO 271
42800	C   9=DASH
42900	251	IF(RB.LT.0)RINV=-RINV
43000	C   FIX THIS!!!!  FOR BOWINGS, ETC.
43100	2222	IF(J5.NE.20)GO TO 2223
43200	CZZZZZZZZZZZ
43300		JA=7
43400		R5=0
43500		J7=1
43600		CALL ALPHA
43700	C  FOR TRILL  -- J5=20
43800		RETURN
43900	2223	IF(J5.EQ.17)GO TO 323
44000		IF(J5.NE.18)GO TO 222
44100	323	RINV=J5
44200	C  FOR MORD, INV.MORD
44300	222	CALL FERMTA(RINV)
44400		GO TO 5241
44500	252	RX=POS
44600	248	CENTR=RX
44700		GO TO 251
44800	246	IF(J5.LT.10)GO TO 245
44900		R4=R4+3
45000		IF(STEM.EQ.1)R4=R4+6.+R8
45100		IF(R4.LT.12.5)R4=12.5
45200		CALL CENTX
45300		IF(J5.EQ.26)GO TO 222
45400	C  26 IS NEW NUMB FOR FERMATA.
45500	28	IF(J5.LT.30)GO TO 281
45600		J5X=MOD(J5,10)
45700	C  J5X SAVES NEXT MARK.
45800		IF(J5X.LT.4)J5X=0
45900		J5=J5/10
46000		IF(J5.GT.30)RETURN
46100	C  WON'T READ 415 ETC. (CORRECT=154)
46200	C DOES BOTTOM MARK FIRST, THEN TOP.
46300		CALL EXCH(J5X,J5)
46400	C  PUTS UPBOW, DNBOW, ETC. ABOVE STACC., ETC.
46500		IF(JA.EQ.1)GO TO 249
46600		GO TO 1241
46700	281	X=1
46800		IF(J5.GT.16)GO TO 2222
46900	C  JUMP FOR MORD, INV.MORD, TRILL
47000		IF(J5.NE.4)GO TO 228
47100		X=5
47200		CALL RJBX(.5)
47300		GO TO 328
47400	228	IF(J5.GT.10)X=XAC(J5-10)
47500	C   X IS POINTER IN RACNT ARRAY
47600	328	RA=RMINI
47700	C   OR RSTJ2?
47800		IF(RINV.LT.0)GO TO 1323
47900		IF(STEM.NE.1)GO TO 2323
48000		IF(J5.NE.4)GO TO 2323
48100	1323	RA=-RA
48200	C  ↓↓↓ X ↓↓↓ PICKS UP TYPO ERRORS
48300	2323	IF(X.LT.54)CALL RDRAW(X+1,RACNT(X),RACNT,RA,R3,CENTR,RMINI)
48400	C              PTR, WDCNT, ARRAY,Y MULT,HOR ADD,VERT ADD, X,Y,MULT
48500	C  IN ARRAY, 33.012 WOULD BE X=33, Y=12.  101.123 IS X=-1, Y=-23.
48600		GO TO 5241
48700	4241	JJJ=J5
48800		J5=J5X
48900		J5X=-1
49000		IF(JAX.NE.1)GO TO 7241
49100		IF(J5.GT.10)GO TO 246
49200		IF(J5.NE.7)GO TO 7241
49300		IF(JJJ.NE.9)GO TO 249
49400	7241	RXX=8.5*RMINI
49500	C↑↑↑↑↑↑  11/74  WAS RH*
49600		IF(STEM.EQ.1)RXX=-RXX
49700		CENTR=CENTR+RXX
49800		IF(J5.EQ.26)J5=6
49900	C  TEMPORARY?? FIX
50000		GO TO 1241
50100	C >=5,  ∧=4
50200	27	R3=J3
50300	C  DASHES
50400	271	CALL LINX(R3,CENTR,R3+RMINI*14.,CENTR)
50500	C    ****   ****    ***  ↑↑↑↑↑↑↑↑↑↑ THIS WAS RSTJ2 11/74
50600	5241	IF(J5X.GT.0)GO TO 4241
50700	C J5X IS FOR DOUBLE MARKS.  (WHAT ABOUT DOT POSITION.)
50800		RETURN
50900	6241	R3=RXX
51000	C  RESET R3 AFTER A DOT.
51100		GO TO 5241
51200	3121	J5=J5+9
51300	C  SOON WILL HAVE DBL FLAT (4) AND DBL SHRP (5)
51400	C  TO DRAW GOOD ACCIS ON PLOTTER - NOT ON DPY.(IN CLEF4.DMD)
51500		CALL DRWNT(RMINI)
51600		GO TO 2422
51700		END